Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/regist2a/regaid.frm

Visual Basic Form | 1999-04-26 | 13.9 KB | 422 lines

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form RegAid
   Caption         =   "RegArbiter"
   ClientHeight    =   8340
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   9720
   Icon            =   "RegAid.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8340
   ScaleWidth      =   9720
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdDelete
      Caption         =   "Delete"
      Height          =   495
      Left            =   3840
      TabIndex        =   20
      ToolTipText     =   "Unregister selected FOUND files with REGSVR32 /u"
      Top             =   2280
      Width           =   1095
   End
   Begin VB.Frame Frame1
      Caption         =   "Registry"
      Height          =   3495
      Left            =   7680
      TabIndex        =   18
      Top             =   120
      Width           =   1815
      Begin VB.CommandButton cmdDeleteRegKey
         Caption         =   "Delete"
         Height          =   495
         Left            =   360
         TabIndex        =   22
         Top             =   2280
         Width           =   975
      End
      Begin VB.CommandButton cmdEditSearch
         Caption         =   "Search Exp"
         Height          =   495
         Left            =   360
         TabIndex        =   21
         Top             =   1440
         Width           =   975
      End
      Begin VB.CommandButton cmdCheckUp
         Caption         =   "Check-Up"
         Height          =   495
         Left            =   360
         TabIndex        =   19
         ToolTipText     =   "Interrogate registry for anomalies."
         Top             =   600
         Width           =   975
      End
   End
   Begin VB.CommandButton cmdDeSelAll
      Caption         =   "Deselect All"
      Height          =   375
      Left            =   1920
      TabIndex        =   17
      ToolTipText     =   "Set any selected files in list box to unselected."
      Top             =   7440
      Width           =   1215
   End
   Begin VB.CommandButton cmdSelAll
      Caption         =   "Select All"
      Height          =   375
      Left            =   480
      TabIndex        =   16
      ToolTipText     =   "Select all files in list box."
      Top             =   7440
      Width           =   1215
   End
   Begin VB.Frame fraFilters
      Caption         =   "Filters"
      Height          =   3495
      Left            =   5400
      TabIndex        =   7
      Top             =   120
      Width           =   2055
      Begin VB.TextBox txtFilter
         Height          =   375
         Left            =   240
         TabIndex        =   11
         Top             =   2400
         Width           =   1575
      End
      Begin VB.CommandButton cmdDeleteFilter
         Caption         =   "Delete"
         Height          =   375
         Left            =   1080
         TabIndex        =   10
         Top             =   2880
         Width           =   735
      End
      Begin VB.CommandButton cmdAddFilter
         Caption         =   "Add"
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   2880
         Width           =   735
      End
      Begin VB.ListBox lstFilters
         Height          =   1620
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Width           =   1575
      End
      Begin VB.Label Label1
         Caption         =   "New Filter:"
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   2160
         Width           =   975
      End
   End
   Begin ComctlLib.StatusBar sbrStatus
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   7965
      Width           =   9720
      _ExtentX        =   17145
      _ExtentY        =   661
      Style           =   1
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
         NumPanels       =   1
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.ListBox lstFiles
      Height          =   2790
      Left            =   480
      MultiSelect     =   2  'Extended
      TabIndex        =   4
      Top             =   4560
      Width           =   9015
   End
   Begin VB.Frame fraActions
      Caption         =   "ActiveX"
      Height          =   3495
      Left            =   3600
      TabIndex        =   2
      Top             =   120
      Width           =   1575
      Begin VB.CommandButton cmdUnRegister
         Caption         =   "Unregister"
         Height          =   495
         Left            =   240
         TabIndex        =   15
         ToolTipText     =   "Unregister selected FOUND files with REGSVR32 /u"
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdRegister
         Caption         =   "Register"
         Height          =   495
         Left            =   240
         TabIndex        =   14
         ToolTipText     =   "Register selected FOUND files with REGSVR32."
         Top             =   960
         Width           =   1095
      End
      Begin VB.CheckBox chkRecurse
         Caption         =   "Recurse Directories"
         Height          =   375
         Left            =   240
         TabIndex        =   5
         ToolTipText     =   "Toggles recursion in search."
         Top             =   2880
         Width           =   1095
      End
      Begin VB.CommandButton cmdFind
         Caption         =   "&Find Files"
         Height          =   495
         Left            =   240
         TabIndex        =   3
         ToolTipText     =   "Search 'Filespec' for files matching filters."
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.DirListBox dirStart
      Height          =   2790
      Left            =   480
      TabIndex        =   1
      Top             =   840
      Width           =   2775
   End
   Begin VB.DriveListBox drvStart
      Height          =   315
      Left            =   480
      TabIndex        =   0
      Top             =   360
      Width           =   2775
   End
   Begin VB.Label Label3
      Caption         =   "Registry Search Criteria:"
      Height          =   375
      Left            =   600
      TabIndex        =   24
      Top             =   3840
      Width           =   1335
   End
   Begin VB.Label lblSearchExp
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   2160
      TabIndex        =   23
      Top             =   3960
      Width           =   7215
   End
   Begin VB.Label Label2
      Caption         =   "Search Filespec:"
      Height          =   255
      Left            =   480
      TabIndex        =   13
      Top             =   120
      Width           =   2415
   End
Attribute VB_Name = "RegAid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'   $Revision: 2 $
'   $Log: /RegAid/RegAid.frm $
'2     4/27/99 9:03a Willib
'Testing Keyword Expansion 1
'  1     4/27/99 8:56a Willib
'  Initial Check-In
Private Sub cmdAddFilter_Click()
Dim intFilterCount As Integer
    For intFilterCount = 0 To lstFilters.ListCount - 1
        If ("*." & txtFilter) = lstFilters.List(intFilterCount) Then
            MsgBox "Duplicate filters not allowed."
            txtFilter = ""
            Exit Sub
        End If
    Next intFilterCount
    If InStr(txtFilter, "*") Or InStr(txtFilter, ".") Then
        MsgBox "Characters * and . not allowed. Enter just the extension, e.g. OCX or DLL."
        txtFilter = ""
        Exit Sub
    End If
    lstFilters.AddItem "*." & Trim$(txtFilter)
    txtFilter = ""
End Sub
Private Sub cmdCheckUp_Click()
Dim blnFound As Boolean
Dim i As Long
    Screen.MousePointer = vbHourglass
    Call RegFind(lblSearchExp, FIND_KEY, blnFound)
    lstFiles.Clear
    If blnFound Then
        For i = 0 To udtResults.lngEntryCount - 1
            lstFiles.AddItem udtResults.varEntryList(i)
        Next i
    Else
        lstFiles.AddItem "No registry items found for search criteria."
    End If
    Screen.MousePointer = vbNormal
End Sub
Private Sub cmdDelete_Click()
On Error GoTo cmdDelete_Click_Error
Dim iCount As Integer
    If lstFiles.SelCount > 0 Then
        For iCount = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(iCount) = True Then
                Kill lstFiles.List(iCount)
            End If
        Next iCount
        For iCount = lstFiles.ListCount - 1 To 0 Step -1
            If lstFiles.Selected(iCount) = True Then
                lstFiles.RemoveItem (iCount)
            End If
        Next
    Else
        MsgBox "You must select files to delete."
    End If
Exit Sub
cmdDelete_Click_Error:
    Select Case Err.Number
        Case 75
            MsgBox "Error '75' : Check the files for read-only attribute."
        Case Else
            MsgBox "Error '" & Str(Err.Number) & "' : Error Deleting files."
    End Select
End Sub
Private Sub cmdDeleteFilter_Click()
Dim lngResult As Long
Dim intListPointer As Integer
    If lstFilters.ListCount = 1 Then
        lngResult = MsgBox("You will not be able to run Find without at least one filter; Delete anyway?", vbYesNo + vbInformation, "RegArbiter")
        If lngResult = vbNo Then
            Exit Sub
        End If
    End If
    lstFilters.RemoveItem lstFilters.ListIndex
    cmdDeleteFilter.Enabled = False
End Sub
Private Sub cmdDeSelAll_Click()
    Dim iCount As Integer
    If lstFiles.ListCount > 0 Then
        For iCount = 0 To lstFiles.ListCount - 1
            lstFiles.Selected(iCount) = False
        Next iCount
    End If
End Sub
Private Sub cmdEditSearch_Click()
Dim strSearchExp As String
    strSearchExp = InputBox("Search Registry for this string", "Search Criteria")
    lblSearchExp = strSearchExp
End Sub
Private Sub cmdFind_Click()
Dim blnCheckOn As Boolean
Dim intFilterCount As Integer
Dim intFilterMax As Integer
Dim strPath As String
    Screen.MousePointer = vbHourglass
    intFilterMax = lstFilters.ListCount
    If intFilterMax = 0 Then
        MsgBox "You must have at least one filter."
        Exit Sub
    End If
    blnCheckOn = IIf(chkRecurse.Value = 0, False, True)
    Erase g_strFiles
    ReDim g_strFiles(0)
    If Right$(dirStart.Path, 1) = "\" Then
        strPath = Left$(dirStart.Path, Len(dirStart.Path) - 1)
    Else
        strPath = dirStart.Path
    End If
    For intFilterCount = 0 To intFilterMax - 1
        Call FindFiles(blnCheckOn, strPath, lstFilters.List(intFilterCount))
    Next intFilterCount
    Call ListFiles(lstFiles)
    Screen.MousePointer = vbNormal
End Sub
Private Sub cmdRegister_Click()
Dim iCount As Integer
Dim lngResult As Long
    If lstFiles.SelCount > 0 Then
        For iCount = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(iCount) = True Then
                If (Right$(lstFiles.List(iCount), 3) = "OCX") _
                Or (Right$(lstFiles.List(iCount), 3) = "DLL") Then
                    lngResult = Shell("regsvr32 " & Chr(34) & lstFiles.List(iCount) & Chr(34), vbNormalNoFocus)
                End If
            End If
        Next iCount
    Else
        MsgBox "You must select files to register."
    End If
End Sub
Private Sub cmdSelAll_Click()
Dim iCount As Integer
    If lstFiles.ListCount > 0 Then
        For iCount = 0 To lstFiles.ListCount - 1
            lstFiles.Selected(iCount) = True
        Next iCount
    End If
End Sub
Private Sub cmdUnRegister_Click()
Dim iCount As Integer
Dim lngResult As Long
    If lstFiles.SelCount > 0 Then
        For iCount = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(iCount) = True Then
                If (Right$(lstFiles.List(iCount), 3) = "OCX") _
                Or (Right$(lstFiles.List(iCount), 3) = "DLL") Then
                    'lngResult = Shell("regsvr32 " & Chr(34) & lstFiles.List(iCount) & Chr(34) & " > " & App.Path & "\output.txt", vbNormalNoFocus)
                    lngResult = Shell("regsvr32 -u " & Chr(34) & lstFiles.List(iCount) & Chr(34), vbNormalNoFocus)
                End If
            End If
        Next iCount
    Else
        MsgBox "You must select files to unregister."
    End If
End Sub
Private Sub drvStart_Change()
    'Keep the directory control in sync
    dirStart.Path = drvStart.Drive
End Sub
Private Sub Form_Load()
    'The beginning path for the controls
    dirStart.Path = drvStart.Drive
    Call PopulateFilter(lstFilters)
    cmdAddFilter.Enabled = False
    cmdDeleteFilter.Enabled = False
    'Center the form
    Center Me
End Sub
Private Sub lstFilters_Click()
    If lstFilters.ListIndex <> -1 Then
        cmdDeleteFilter.Enabled = True
    Else
        cmdDeleteFilter.Enabled = False
    End If
End Sub
Private Sub txtFilter_Change()
    If Len(txtFilter) = 0 Then
        cmdAddFilter.Enabled = False
    Else

        cmdAddFilter.Enabled = True
    End If
End Sub
Private Sub txtFilter_LostFocus()
    txtFilter = UCase$(txtFilter)
End Sub